home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-06 / mcmenu.zip / WIN.PAS < prev    next >
Pascal/Delphi Source File  |  1992-02-23  |  5KB  |  180 lines
  1. UNIT Win;
  2. {*******************************************************}
  3. {                                                       }
  4. {       Turbo Pascal Version 5.5                        }
  5. {       Window Interface Unit                           }
  6. {                                                       }
  7. {       Copyright (C) 1989 Borland International        }
  8. {                                                       }
  9. {*******************************************************}
  10. { Extensively modified By Tony Bigras for MCMenu
  11.   march 1992
  12.   WIN.OBJ as original from Borland
  13. }
  14. {$D-,S-}
  15.  
  16. INTERFACE
  17.  
  18. USES Crt;
  19.  
  20. TYPE
  21.  
  22. { Window title string }
  23.  
  24.   TitleStr = string[63];
  25.  
  26. { Window frame characters }
  27.  
  28.   FrameChars = array[1..10] of Char;
  29.  
  30. { Window state record }
  31.  
  32.   WinState = record
  33.     WindMin, WindMax: Word;
  34.     WhereX, WhereY: Byte;
  35.     TextAttr: Byte;
  36.   end;
  37.  
  38. CONST
  39.  
  40. { Standard frame character sets }
  41.  
  42.   SingleFrame: FrameChars = '┌─┐││└─┘├┤';
  43.   DoubleFrame: FrameChars = '╔═╗║║╚═╝╠╣';
  44.  
  45. { Direct write routines }
  46.  
  47. procedure WriteStr(X, Y: Byte; S: String; Attr: Byte);
  48. procedure WriteChar(X, Y, Count: Byte; Ch: Char; Attr: Byte);
  49.  
  50. { Window handling routines }
  51.  
  52. procedure FillWin(Ch: Char; Attr: Byte);
  53. procedure ReadWin(var Buf);
  54. procedure WriteWin(var Buf);
  55. function WinSize: Word;
  56. procedure SaveWin(var W: WinState);
  57. procedure RestoreWin(var W: WinState);
  58. PROCEDURE tframewin(title: titlestr; var frame: framechars;
  59.   titleattr, frameattr: BYTE);
  60. PROCEDURE framewin(VAR frame: framechars; frameattr: BYTE);
  61. PROCEDURE splitbox(var frame: framechars;FrameAttr: Byte;split: INTEGER);
  62. PROCEDURE unframewin;
  63.  
  64. implementation
  65.  
  66. {$L WIN}
  67.  
  68. procedure WriteStr(X, Y: Byte; S: String; Attr: Byte);
  69. external {WIN};
  70.  
  71. procedure WriteChar(X, Y, Count: Byte; Ch: Char; Attr: Byte);
  72. external {WIN};
  73.  
  74. procedure FillWin(Ch: Char; Attr: Byte);
  75. external {WIN};
  76.  
  77. procedure WriteWin(var Buf);
  78. external {WIN};
  79.  
  80. procedure ReadWin(var Buf);
  81. external {WIN};
  82.  
  83. function WinSize: Word;
  84. external {WIN};
  85.  
  86. procedure SaveWin(var W: WinState);
  87. begin
  88.   W.WindMin := WindMin;
  89.   W.WindMax := WindMax;
  90.   W.WhereX := WhereX;
  91.   W.WhereY := WhereY;
  92.   W.TextAttr := TextAttr;
  93. end;
  94.  
  95. procedure RestoreWin(var W: WinState);
  96. begin
  97.   WindMin := W.WindMin;
  98.   WindMax := W.WindMax;
  99.   GotoXY(W.WhereX, W.WhereY);
  100.   TextAttr := W.TextAttr;
  101. end;
  102.  
  103. procedure tFrameWin(Title: TitleStr; var Frame: FrameChars;
  104.   TitleAttr, FrameAttr: Byte);
  105. var
  106.   W, H, Y: Word;
  107. begin
  108.   W := Lo(WindMax) - Lo(WindMin) + 1;
  109.   H := Hi(WindMax) - Hi(WindMin) + 1;
  110.   WriteChar(1, 1, 1, Frame[1], FrameAttr);
  111.   WriteChar(2, 1, W - 2, Frame[2], FrameAttr);
  112.   WriteChar(W, 1, 1, Frame[3], FrameAttr);
  113.   if Length(Title) > W - 2 then Title[0] := Chr(W - 2);
  114.   WriteStr((W - Length(Title)) shr 1 + 1, 1, Title, TitleAttr);
  115.   for Y := 2 to H - 1 do
  116.   begin
  117.     WriteChar(1, Y, 1, Frame[4], FrameAttr);
  118.     WriteChar(W, Y, 1, Frame[5], FrameAttr);
  119.   end;
  120.   WriteChar(1, H, 1, Frame[6], FrameAttr);
  121.   WriteChar(2, H, W - 2, Frame[7], FrameAttr);
  122.   WriteChar(W, H, 1, Frame[8], FrameAttr);
  123.   Inc(WindMin, $0101);
  124.   Dec(WindMax, $0101);
  125. end;
  126.  
  127. procedure FrameWin(var Frame: FrameChars; FrameAttr: Byte);
  128. var
  129.   W, H, Y: Word;
  130. begin
  131.   W := Lo(WindMax) - Lo(WindMin) + 1;
  132.   H := Hi(WindMax) - Hi(WindMin) + 1;
  133.   WriteChar(1, 1, 1, Frame[1], FrameAttr);
  134.   WriteChar(2, 1, W - 2, Frame[2], FrameAttr);
  135.   WriteChar(W, 1, 1, Frame[3], FrameAttr);
  136.   for Y := 2 to H - 1 do
  137.   begin
  138.     WriteChar(1, Y, 1, Frame[4], FrameAttr);
  139.     WriteChar(W, Y, 1, Frame[5], FrameAttr);
  140.   end;
  141.   WriteChar(1, H, 1, Frame[6], FrameAttr);
  142.   WriteChar(2, H, W - 2, Frame[7], FrameAttr);
  143.   WriteChar(W, H, 1, Frame[8], FrameAttr);
  144.   Inc(WindMin, $0101);
  145.   Dec(WindMax, $0101);
  146. end;
  147.  
  148.   PROCEDURE splitbox(var frame: framechars;FrameAttr: Byte;split: INTEGER);
  149.   var
  150.     W, H, Y: Word;
  151.   begin   { splitbox }
  152.     W := Lo(WindMax) - Lo(WindMin) + 1;
  153.     H := Hi(WindMax) - Hi(WindMin) + 1;
  154.     WriteChar(1, 1, 1, Frame[1], FrameAttr);
  155.     WriteChar(2, 1, W - 2, Frame[2], FrameAttr);
  156.     WriteChar(W, 1, 1, Frame[3], FrameAttr);
  157.     for Y := 2 to H - 1 do
  158.     begin
  159.       WriteChar(1, Y, 1, Frame[4], FrameAttr);
  160.       WriteChar(W, Y, 1, Frame[5], FrameAttr);
  161.     end;
  162.     WriteChar(1, H, 1, Frame[6], FrameAttr);
  163.     WriteChar(2, H, W - 2, Frame[7], FrameAttr);
  164.     WriteChar(W, H, 1, Frame[8], FrameAttr);
  165.     WriteChar(1, split, 1, Frame[9], FrameAttr);
  166.     WriteChar(2, split, W - 2, Frame[7], FrameAttr);
  167.     WriteChar(W, split, 1, Frame[10], FrameAttr);
  168.     Inc(WindMin, $0101);
  169.     Dec(WindMax, $0101);
  170.   END; { splitbox }
  171.  
  172.  
  173. procedure UnFrameWin;
  174. begin
  175.   Dec(WindMin, $0101);
  176.   Inc(WindMax, $0101);
  177. end;
  178.  
  179. end.
  180.